home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / stretch / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-07-07  |  7.8 KB  |  196 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   4605
  6.    ClientLeft      =   1080
  7.    ClientTop       =   1470
  8.    ClientWidth     =   5925
  9.    Height          =   5010
  10.    Left            =   1020
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4605
  13.    ScaleWidth      =   5925
  14.    Top             =   1125
  15.    Width           =   6045
  16.    Begin CommandButton Command4 
  17.       Caption         =   "Exit"
  18.       Height          =   375
  19.       Left            =   120
  20.       TabIndex        =   6
  21.       Top             =   2280
  22.       Width           =   855
  23.    End
  24.    Begin PictureBox Picture3 
  25.       Height          =   315
  26.       Left            =   120
  27.       ScaleHeight     =   285
  28.       ScaleWidth      =   825
  29.       TabIndex        =   5
  30.       Top             =   660
  31.       Width           =   855
  32.    End
  33.    Begin CommandButton Command3 
  34.       Caption         =   "Smaller"
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   4
  38.       Top             =   1860
  39.       Width           =   855
  40.    End
  41.    Begin CommandButton Command2 
  42.       Caption         =   "Bigger"
  43.       Height          =   375
  44.       Left            =   120
  45.       TabIndex        =   3
  46.       Top             =   1440
  47.       Width           =   855
  48.    End
  49.    Begin CommandButton Command1 
  50.       Caption         =   "Go"
  51.       Height          =   375
  52.       Left            =   120
  53.       TabIndex        =   1
  54.       Top             =   1020
  55.       Width           =   855
  56.    End
  57.    Begin PictureBox Picture1 
  58.       AutoRedraw      =   -1  'True
  59.       AutoSize        =   -1  'True
  60.       Height          =   510
  61.       Left            =   480
  62.       Picture         =   FORM1.FRX:0000
  63.       ScaleHeight     =   480
  64.       ScaleWidth      =   480
  65.       TabIndex        =   0
  66.       Top             =   60
  67.       Width           =   510
  68.    End
  69.    Begin PictureBox Picture2 
  70.       AutoRedraw      =   -1  'True
  71.       Height          =   1215
  72.       Left            =   1080
  73.       ScaleHeight     =   79
  74.       ScaleMode       =   3  'Pixel
  75.       ScaleWidth      =   95
  76.       TabIndex        =   2
  77.       Top             =   60
  78.       Width           =   1455
  79.    End
  80. Sub Command1_Click ()
  81. Dim PL As Single, PW As Single, PT As Single, PH As Single
  82. Dim Color() As Long
  83. Dim I As Single, J As Single, IOff As Single
  84. Picture2.Cls                        'Clear previous graphics
  85. Picture2.Picture = LoadPicture()    'Clear previous picture
  86. Picture2.Refresh
  87. Picture3.Cls
  88. Picture3.Scale (0, 0)-(100, 100) 'Makes status bar math easier for me.
  89. PL = Picture1.ScaleLeft
  90. PW = Picture1.ScaleWidth
  91. PT = Picture1.ScaleTop
  92. PH = Picture1.ScaleHeight
  93. ReDim Color(PW - PL, PH - PT) As Long 'Resize the array to match Picture1's scale mode.
  94.                                       'Did it backwards just for fun.
  95. Form1.MousePointer = 11
  96. For I = PL To PW     'Left to right
  97.     For J = PT To PH 'Top to bottom
  98.         Color(I, J) = Picture1.Point(I, J) 'Get pixel color and assign to array.
  99.     Next
  100. Picture3.Line (0, 0)-(I / PW * 100, 100), , BF 'Update status bar once each major loop.
  101. Picture3.Cls 'Clear staus bar for stretch loop.
  102. For I = PL To PW     'Left to right
  103.     For J = PT To PH 'Top to bottom
  104.         On Error Resume Next  'Could someone tell me how to get this line out?
  105.         Picture2.Line (I, J)-(I + 1, J + 1), Color(I, J), BF 'Get color from array and draw one "pixel".
  106.             'Interesting stuff here. The line method will not
  107.             'draw the end point. And if you dont give it more
  108.             'than one "pixel" to draw, you get nothing.
  109.         'Picture2.Refresh  ' Un-Comment this if you want to watch the stretched being drawn.
  110.         'DoEvents 'This one does the same thing, from a speed perspective.
  111.     Next
  112. Picture3.Line (0, 0)-(I / PW * 100, 100), , BF 'Update status bar once each major loop.
  113. IOff = 1 / PH 'Corrects for slight difference between sizes
  114.               'of boxes in first and last grid rows and columns
  115.               'Doesn't work if Picture2 is too small
  116. For I = 1 To PH - 1
  117.     Picture2.Line (0, I - IOff)-(PW, I - IOff) 'Draw horizontal lines
  118. IOff = 1 / PW 'Corrects for slight difference between
  119.               'locations of first and last grid lines
  120.               'Doesn't work if Picture2 is too small
  121. For I = 1 To PW - 1
  122.     Picture2.Line (I - IOff, 0)-(I - IOff, PH) 'Draw verticle lines
  123. Picture2.Picture = Picture2.Image 'In case you want to save it
  124. Picture2.Refresh
  125. Form1.MousePointer = 0
  126. 'MsgBox Str$(I * J) 'This will tell you the number of pixels stored in the array.
  127. End Sub
  128. Sub Command2_Click ()
  129. Picture2.Width = Picture2.Width * 1.5
  130. Picture2.Height = Picture2.Height * 1.5
  131. Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  132. 'This, in combination with the Line...BF method, is what
  133. 'actually does the stretching (or shrinking). The effect,
  134. 'since Picture1's ScaleMode is pixels, is that you are
  135. 'simply drawing large, square pixels.
  136. End Sub
  137. Sub Command3_Click ()
  138. Picture2.Width = Picture2.Width * .75
  139. Picture2.Height = Picture2.Height * .75
  140. Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  141. 'This, in combination with the Line...BF method, is what
  142. 'actually does the stretching (or shrinking). The effect,
  143. 'since Picture1's ScaleMode is pixels, is that you are
  144. 'simply drawing large, square pixels.
  145. End Sub
  146. Sub Command4_Click ()
  147. End Sub
  148. Sub Form_Load ()
  149.     Picture1.ScaleMode = 3 'Pixels
  150.     Picture2.Width = Picture1.Width
  151.     Picture2.Height = Picture1.Height
  152.     Picture2.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
  153.     'The above line is also in the click events that
  154.     'resize Picture2, Commands 2 and 3
  155. End Sub
  156. Sub Picture1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  157.     MsgBox Str$(Picture1.Point(X, Y)) 'Get the color of the pixel under the cursor
  158. End Sub
  159. Sub Picture2_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  160.     MsgBox Str$(Picture2.Point(X, Y))  'Get the color of the pixel under the cursor
  161. End Sub
  162. Sub Read_Me ()
  163. 'To use this thing, just run it and click "Bigger" a couple
  164. 'times, then click "Go".
  165. 'All the goodies are in the click events and picture mousedowns
  166. 'I know they should be in a sub or two, but after all, this
  167. 'was playtime. I just felt like seeing what the Point method
  168. 'was all about since most of the time I'm a database idiot.
  169. 'I also wanted to see what I could do with VB instead of
  170. 'using StretchBlt.
  171. 'I started out to do this by using an Image control to stretch
  172. 'the image but I ran into trouble when I tried to transfer
  173. 'the stretched image to a picture control (for the grid),
  174. 'since the image control has no image property(?!). Or for
  175. 'that matter an hWnd property. I also didn't feel like
  176. 'playing with hDCs. The result of all this negativity is what
  177. 'you see here. I hope you find it amusing.
  178. 'If for some strange reason you decide to use this in one of
  179. 'your apps, please thank me somewhere in it's documetation,
  180. 'or offer me a job (no joke).
  181. 'One question I have about it is this. If one were doing a
  182. 'MDI or other multiple image graphics app, would there be any
  183. 'benefit in assigning a third dimension to the array Color()
  184. 'in Command1 and assigning different images to that third
  185. 'dimension, or should each image have it's own array. I realize
  186. 'it would have to be declared elsewhere. Or should one always
  187. 're-read the original image. I realize memory could get full
  188. 'pretty fast but hey, Chicago's coming which means we'll all
  189. 'be customers at Memory Express <G>.
  190. 'If there isn't enough comments in the code, drop me a line
  191. 'at 72123,1243 or at AaronCr on AOL (aaroncr@aol.com) or
  192. 'leave me a note in the Basic Forum.
  193. 'Enjoy!
  194. 'Aaron P. Crouse
  195. End Sub
  196.